8bitfiles.net/archives

home *** CD-ROM | disk | FTP | other *** search

/ 8bitfiles.net/archives / archives.tar / archives / compuserve-file-archive / 22 Graphics & Utilities / FRACSC.BIN / fracscapes64 (.txt) next >

Wrap

Commodore BASIC | 1990-02-12 | 15.1 KB | 512 lines

10 REM FRACSCAPES 64 20 REM OR 30 REM 3-D FRACTAL LANDSCAPES 40 REM 50 REM BY MICHIEL VAN DE PANNE 60 REM FROM THE JULY ISSUE OF CREATIVE 70 REM COMPUTING (R.I.P.) 80 REM 90 REM HACKED UNMERCIFULLY AND 100 REM MODIFIED FOR THE AMIGA FROM 110 REM THE MAC VERSION BY 120 REM DAVID MILLIGAN, 70707,2521 130 REM AND TED INGALLS 140 REM 10-19-85 150 REM 160 REM ** THIS PROGRAM WILL CONSTRUCT 170 REM ** A REALISTIC 3-D LANDSCAPE 180 REM ** FRACTAL FROM MANY RANDOM 190 REM ** NUMBERS IN UP TO SEVEN 200 REM ** LEVELS OF DETAIL,SIMULATING 210 REM ** MOUNTAIN RANGES, COASTLINES 220 REM ** SEA FLOOR AND/OR SURFACES, 230 REM ** LAKES,ISLANDS,ETC. 240 REM ** ONCE THE ARRAY USED TO DO 250 REM ** THE DRAWING IS CREATED,IT 260 REM ** CAN BE SAVED TO DISK AND 270 REM ** RELOADED AND RE-DRAWN. 280 REM ** WE SAVED THE ARRAY RATHER 290 REM ** THAN THE SCREEN BECAUSE: 300 REM ** (1) WE COULDN'T FIGURE OUT 310 REM ** HOW TO FIND THE START OF 320 REM ** SCREEN MEMORY FROM ABASIC 330 REM ** AND COULDN'T GET A 640X200 340 REM ** SCREEN STUFFED INTO AN 350 REM ** ARRAY, AND 360 REM ** (2) THE ARRAY CAN BE 370 REM ** RE-DRAWN WITH DIFFERENT 380 REM ** SCALING FACTORS FOR 390 REM ** PERSPECTIVE CHANGES AND 400 REM ** WITH SEA LEVEL ON OR OFF 410 REM ** (DEFAULT IS OFF). 420 REM ** THE LENGTH OF TIME REQUIRED 430 REM ** TO DRAW AN ARRAY DEPENDS 440 REM ** ON THE NUMBER OF LEVELS 450 REM ** SELECTED. FOR EACH INCREASE 460 REM ** IN LEVEL THE NUMBER OF 470 REM ** TRIANGULAR SUBDIVISIONS IS 480 REM ** QUADRUPLED. A LEVEL 7 490 REM ** LANDSCAPE HAS THE HIGHEST 500 REM ** 'RESOLUTION', BUT TAKES 510 REM ** OVER AN HOUR TO DRAW. 520 REM 530 REM ** ONE OF THE MAIN THINGS WE 540 REM ** ADDED TO THE ORIGINAL 550 REM ** PROGRAM WAS COLOR. THE 12 560 REM ** COLORS ARE SELECTED BY WHAT 570 REM ** WE DETERMINED WAS ALTITUDE 580 REM ** TO RENDER FORESTS,WATER 590 REM ** SNOW, DIRT, ETC. 600 REM ** CONSIDERING WE UNDERSTAND 610 REM ** VITUALLY NOTHING OF THE 620 REM ** MATH INVOLVED, IT WORKS 630 REM ** PRETTY WELL. 640 REM ** IF YOU'VE GOT A BETTER 650 REM ** IDEA, HAVE AT IT. 660 REM ** THIS PROGRAM IS DEFINATELY 670 REM ** NOT POLISHED,OPTIMIZED OR 680 REM ** BUG FREE, BUT IT IS FUN TO 690 REM ** PLAY WITH. 700 REM ** WHILE I DON'T UNDERSTAND 710 REM ** THEM, I FIND FRACTAL 720 REM ** GRAPHICS GENERATION 730 REM ** FASCINATING. IF YOU'VE GOT 740 REM ** A NIFTY FRACTAL PROGRAM, 750 REM ** UPLOAD IT HERE OR SING OUT 760 REM ** VIA E-MAIL. 770 REM 780 REM DAVID MILLIGAN, 70707,2521 790 REM ****************************** 800 REM 810 REM ** FRACSCAPE 64 WOULD NOT BE 820 REM AS NICE WITHOUT THE HIGH 830 REM RESOLUTION GRAPHICS UTILITY 831 REM ($C000-$C81F) 840 REM BY GARY KIZIAK FROM VOLUME 850 REM 5,ISSUE 6 OF TRANSACTOR 860 REM MAGAZINE. ****THANKS******** 872 REM THE REST OF FILE 'HIHIRES' 873 REM IS A HIRES SCREEN DUMP 874 REM PROGRAM ($C820-$CAA0) 875 REM 880 REM ** THIS PROGRAM WAS CONVERTED 890 REM FROM AMIGA ABASIC FOR THE C64 900 REM BY DOUG COWARD (DONQUIXOTE ON 910 REM Q-LINK) 920 REM 930 REM THE LOSS OF COLOR THAT THE 940 REM AMIGA IS CAPABLE OF DOES NOT 950 REM TAKE AWAY FROM THE BEAUTY OF 960 REM THESE FRACTALS. 970 REM STANDARD BITMAP MODE DRAWS IN 980 REM ONE COLOR (I PICKED DK. GRAY) 990 REM MULTICOLOR MODE DRAWS IN THREE 1000 REM COLORS ( DK.GRAY,BLUE,GREEN OR 1010 REM DK.GRAY,GREEN,WHITE) 1020 REM 1030 REM PN= ** COLORS ** 1040 REM SEALEVEL= 0 1 0 1 1050 REM MC=MULCOLOR 0 0 1 1 1060 REM 0 BACKGROUND 14 14 14 14 1070 REM 1 FOREGROUND 11 11 5 6 1080 REM 2 MULTICOLOR1 -- -- 11 5 1090 REM 3 MULTICOLOR2 -- -- 1 11 1100 REM 4 BORDER 14 14 14 14 1110 REM -------------------------- 1120 REM 1 = WHITE (SNOW) 1130 REM 6 = BLUE (WATER) 1140 REM 11= DARK GRAY (ROCK) 1150 REM 5 = GREEN (FOREST) 1160 REM 14= LIGHT BLUE (SKY) 1170 REM 1180 REM THIS PROGRAM CAN BE IMPROVED. 1190 REM IF YOU HAVE IMPROVEMENTS OR IF 1200 REM UNDERSTAND THE MATH OF FRACTAL 1210 REM SEND E-MAIL. ** ENJOY ** 1220 REM DOUG COWARD 1230 REM ============================= 1235 IF A=0 THEN A=1:LOAD "HIHIRES",8,1 1240 HI=12*4096:DR=HI+3:PL=DR+3:MO=PL+3:CL=MO+3:DM=CL+3: 1250 SC=DM+3:CO=SC+3:BO=CO+3:TE=BO+3:PR=TE+3:CH=PR+3:TR=CH+3 1260 PRINTCHR$(147):SYSTRAP:PI=3.14159:GOSUB1430:PRINT CHR$(158) 1270 PRINT" FRACSCAPES 64" 1280 PRINT" THIS PROGRAM WAS CONVERTED FROM AMIGA " 1290 PRINT" ABASIC FOR THE C64 BY DOUG COWARD" 1300 PRINT" (DONQUIXOTE)" 1310 PRINT" SELECT STANDARD HIRES":PRINT" (ONE COLOR)" 1320 PRINT" OR SELECT MULTICOLOR BITMAP MODE FOR" 1330 PRINT" THREE COLORS AT LOWER RESOLUTION" 1340 REM *** PROGRAM INITIALIZATION *** 1350 PRINT" INITIALIZING ARRAYS" 1360 DIMD(64,33):LE=0 1370 GOSUB4870:FORI=1TO2000:NEXT:GOTO3120 1380 REM ============================== 1390 REM *** WAIT FOR ANY KEY *** 1400 GETA$:IFA$=""THEN1400 1410 RETURN 1420 REM ============================== 1430 REM *** SET INITIAL COLORS *** 1440 POKE53280,14:POKE53281,14 1450 C1=11:C2=1:C3=6 1460 RETURN 1470 REM ============================== 1480 REM CALCULATE ARRAY DATA AND INSERT 1490 PRINT" WORKING ON LEVEL " 1500 DT=2:FORN=1TOLE:DT=DT+2^(N-1):NEXTN 1510 MX=DT-1:MY=MX/2:RH=PI*30/180:VT=RH*1.2 1520 FORN=1TOLE:L=10000/1.8^N 1530 PRINT:PRINT" ";N 1540 IB=MX/2^N:SK=IB*2 1550 GOSUB1610:REM ASSIGN HEIGHTS ALONG X IN ARRAY 1560 GOSUB1690:REM *** ASSIGN HEIGHTS ALONG Y *** 1570 GOSUB1770:REM *** ASSIGN HEIGHTS ALONG Z *** 1580 NEXTN 1590 PRINTCHR$(147):GOTO3030 1600 REM ============================= 1610 REM *** HEIGHTS ALONG X *** 1620 FORYE=0TOMX-1STEPSK 1630 FORXE=IB+YETOMXSTEPSK 1640 AX=XE-IB:AY=YE:GOSUB1860:D1=D:AX=XE+IB:GOSUB1860:D2=D 1650 D=(D1+D2)/2+RND(1)*L/2-L/4:AX=XE:AY=YE:GOSUB1920 1660 NEXTXE 1670 NEXTYE:RETURN 1680 REM ============================= 1690 REM *** HEIGHTS ALONG Y *** 1700 FORXE=MXTO1STEP-SK 1710 FORYE=IBTOXESTEPSK 1720 AX=XE:AY=YE+IB:GOSUB1860:D1=D:AY=YE-IB:GOSUB1860:D2=D 1730 D=(D1+D2)/2+RND(1)*L/2-L/4:AX=XE:AY=YE:GOSUB1920 1740 NEXTYE 1750 NEXTXE:RETURN 1760 REM ============================= 1770 REM *** HEIGHTS ALONG Z *** 1780 FORXE=0TOMX-1STEPSK 1790 FORYE=IBTOMX-XESTEPSK 1800 AX=XE+YE-IB:AY=YE-IB:GOSUB1860:D1=D 1810 AX=XE+YE+IB:AY=YE+IB:GOSUB1860:D2=D 1820 AX=XE+YE:AY=YE:D=(D1+D2)/2+RND(1)*L/2-L/4:GOSUB1920 1830 NEXTYE 1840 NEXTXE:RETURN 1850 REM ============================= 1860 REM *** RETURN DATA FROM ARRAY *** 1870 IFAY>MYTHEN1890 1880 BY=AY:BX=AX:GOTO1900 1890 BY=MX+1-AY:BX=MX-AX 1900 D=D(BX,BY):RETURN 1910 REM ============================= 1920 REM *** PUT DATA INTO ARRAY *** 1930 IFAY>MYTHEN1950 1940 BY=AY:BX=AX:GOTO1960 1950 BY=MX+1-AY:BX=MX-AX 1960 D(BX,BY)=D:RETURN 1970 REM ============================= 1980 REM *** SEA LEVEL SECTION *** 1990 IFSEALEVEL=0THENGOSUB2190:RETURN 2000 IFXO<>-999THEN2030 2010 IFZZ<0THENGOSUB2410:Z2=ZZ:ZZ=0:GOTO2170 2020 GOSUB2450:GOTO2160 2030 IFZ2>0ANDZZ>0THENGOSUB2190:GOTO2160 2040 IFZ2<0ANDZZ<0THENZ2=ZZ:ZZ=0:GOTO2170 2050 W3=ZZ/(ZZ-Z2):X3=(X2-XX)*W3+XX:Y3=(Y2-YY)*W3+YY:Z3=0 2060 ZT=ZZ:YT=YY:XT=XX 2070 IFZZ>0THEN2130 2080 REM ============================= 2090 REM *** GOING INTO WATER *** 2100 ZZ=Z3:YY=Y3:XX=X3:GOSUB2710 2110 GOSUB2410:ZZ=0:YY=YT:XX=XT:Z2=ZT:GOTO2170 2120 REM ============================= 2130 REM *** COMING OUT OF WATER *** 2140 ZZ=Z3:YY=Y3:XX=X3:GOSUB2710 2150 GOSUB2450:ZZ=ZT:YY=YT:XX=XT 2160 Z2=ZZ 2170 X2=XX:Y2=YY:RETURN 2180 REM ============================= 2190 REM *** NEW COLOR SUBROUTINE *** 2200 IFZZ<0THENGOTO2330 2210 REM IF ZZ>950 THEN PENA 2:RETURN 2220 REM IF ZZ>850 THEN PENA 3:RETURN 2230 REM IF ZZ>750 THEN PENA 4:RETURN 2240 IFZZ>750THENPN=C3:GOTO2300 2250 REM IF ZZ>550 THEN PENA 6:RETURN 2260 REM IF ZZ>450 THEN PENA 7:RETURN 2270 REM IF ZZ>350 THEN PENA 12:RETURN 2280 REM IF ZZ>100 THEN PENA 12:RETURN 2290 GOSUB2450 2300 IFMC=0THENPN=C1 2310 RETURN 2320 REM ============================= 2330 REM *** BELOW SEA LEVEL *** 2340 IFZZ>-200THENGOSUB2410:RETURN 2350 REM IF ZZ>-500 THEN PENA 9:RETURN 2360 REM IF ZZ>-800 THEN PENA 10:RETURN 2370 REM IF ZZ>-1200 THEN PENA 11:RETURN 2380 REM PENA 11 2390 RETURN 2400 REM ============================= 2410 REM *** SWITCH TO SEA LEVEL COLOR *** 2420 PN=C1 2430 F1=1:RETURN 2440 REM ============================= 2450 REM *** SWITCH TO LAND COLOR *** 2460 IFMC=1THENPN=C2:GOTO2480 2470 PN=C1 2480 F1=0:RETURN 2490 REM ============================= 2500 REM *** ROTATION *** 2510 IFXX<>0THEN2540 2520 IFYY<=0THENRA=-PI/2:GOTO2560 2530 RA=PI/2:GOTO2560 2540 RA=ATN(YY/XX) 2550 IFXX<0THENRA=RA+PI 2560 R1=RA+RH:RD=SQR(XX*XX+YY*YY) 2570 XX=RD*COS(R1):YY=RD*SIN(R1) 2580 RETURN 2590 REM ============================= 2600 REM *** TILT DOWN *** 2610 RD=SQR(ZZ*ZZ+XX*XX) 2620 IFXX=0THENRA=PI/2:GOTO2650 2630 RA=ATN(ZZ/XX) 2640 IFXX<0THENRA=RA+PI 2650 R1=RA-VT 2660 XX=RD*COS(R1)+XX:ZZ=RD*SIN(R1) 2670 RETURN 2680 REM ============================= 2690 REM *** PLOT TO (XP,YP) *** 2700 GOSUB1980 2710 XX=XX*XS:YY=YY*YS:ZZ=ZZ*ZS 2720 GOSUB2500:REM *** ROTATE *** 2730 GOSUB2600:REM *** TILT UP *** 2740 IFXO=-999THENPR$="M":GOTO2760 2750 PR$="D" 2760 XP=INT(YY)+CX:YP=INT(ZZ) 2770 REM ============================= 2780 REM *** DO PLOTTING HERE *** 2790 GETA$:IFA$<>""THEN3120 2800 IFMC=1THENXP=XP/2 2810 XP=XP*.70:YP=140.47+.663*YP:IFPR$="M"THENX8=XP:Y8=YP 2820 SYSDRAW,X8,Y8TOXP,YP,PN:X8=XP:Y8=YP:XO=XP 2830 RETURN 2840 REM ============================= 2850 REM *** PLOT X AXIS *** 2860 FORAX=0TOMX:XO=-999:FORAY=0TOAX 2870 GOSUB1860:ZZ=D:YY=AY/MX*10000:XX=AX/MX*10000-YY/2 2880 GOSUB2690:NEXTAY:NEXTAX 2890 RETURN 2900 REM ============================= 2910 REM *** PLOT Y AXIS *** 2920 FORAY=0TOMX:XO=-999:FORAX=AYTOMX 2930 GOSUB1860:ZZ=D:YY=AY/MX*10000:XX=AX/MX*10000-YY/2 2940 GOSUB2690:NEXTAX:NEXTAY 2950 RETURN 2960 REM ============================= 2970 REM *** PLOT Z AXIS *** 2980 FOREX=0TOMX:XO=-999:FOREY=0TOMX-EX 2990 AX=EX+EY:AY=EY:GOSUB1860:ZZ=D:YY=AY/MX*10000 3000 XX=AX/MX*10000-YY/2:GOSUB2690:NEXTEY:NEXTEX 3010 RETURN 3020 REM ============================= 3030 REM *** SETUP SCREEN *** 3040 IFMC=1THENSYSHIRES,1,4,C2,C1,C3:GOTO3060 3050 SYSHIRES,0,4,C1 3060 POKE53280,4:TAX=AX:TAY=AY 3070 GOSUB2970:REM ** PLOT Z AXIS ** 3080 GOSUB2910:REM ** PLOT Y AXIS ** 3090 GOSUB2850:REM ** PLOT X AXIS ** 3100 GOSUB1390 3110 REM ============================= 3120 REM *** MAIN MENU SECTION *** 3130 SYSTEXT:PRINTCHR$(147) 3140 POKE53280,14:POKE53281,14 3150 PRINT" CURRENT SETTINGS:":PRINT 3160 IFMC=0THENPRINT" STANDARD BITMAP MODE" 3170 IFMC=1THENPRINT" MULTICOLOR BITMAP MODE" 3180 PRINT" SEALEVEL OPTION ";:IFSEALEVEL=0THENPRINT"OFF" 3190 IFSEALEVEL<>0THENPRINT"ON" 3200 PRINT" SCALE - X=";XS;" Y=";YS;" Z=";ZS 3210 PRINT" -) MAIN MENU (-" 3220 PRINT" 1 - START NEW LANDSCAPE" 3230 PRINT" 2 - DRAW EXISTING ARRAY" 3240 PRINT" 3 - DISPLAY CURRENT HIRES SCREEN" 3250 PRINT" 4 - SAVE FRACTAL ARRAY OR SCREEN" 3260 PRINT" 5 - LOAD FRACTAL ARRAY OR SCREEN" 3270 PRINT" 6 - RESET SCALING FACTORS" 3280 PRINT" 7 - SET SEA LEVEL OPTIONS" 3290 PRINT" 8 - SWITCH BITMAP MODE" 3300 PRINT" 9 - PRINT HIRES SCREEN" 3310 PRINT" 0 - EXIT TO BASIC" 3320 PRINT:PRINT 3330 PRINT" SELECTION (0-9) "; 3340 GETA$:IFA$<"0"ORA$>"9"THEN3340 3350 A=ASC(A$)-48:PRINTCHR$(147) 3360 ONAGOTO3410,4580,4290,3570,3890,4680,4340,4430,3490 3370 REM ============================= 3380 REM *** PROGRAM EXIT *** 3390 PRINTCHR$(147):END 3400 REM ============================= 3410 PRINT" ** START A NEW FRACTAL LANDSCAPE **" 3420 PRINT" ENTER NUMBER OF LEVELS (1-6)";:INPUTLE 3430 PRINTCHR$(147):IFLE<1ORLE>6THEN3420 3440 PRINT" PRESS ANY KEY TO START." 3450 PRINT" PRESS WHILE DRAWING TO ABORT." 3460 GOSUB1390:PRINTCHR$(147) 3470 GOTO1480 3480 REM ============================= 3490 PRINT "PRINT HIRES SCREEN TO COMMODORE PRINTER" 3500 PRINT "AS DEVICE 4":PRINT 3505 PRINT" PRESS 1 FOR 1/4 PAGE SIZE" 3507 PRINT" 2 FOR FULL PAGE SIZE" 3508 GETA$:IF A$<"1"ORA$>"2"THEN3508 3509 POKE2,2:IF A$="1" THEN POKE2,1 3510 IF MC=0 THEN SYSHIRES,0:GOTO 3530 3520 SYSHIRES,1 3530 SYS51232 3550 GOTO 3120 3560 REM ============================= 3570 PRINT" *** ARRAY OR SCREEN SAVE ***" 3580 NAME$="":SL=0:SH=0:EL=0:EH=0 3590 PRINT" TO SAVE THE SCREEN, THE COLOR SCREEN" 3600 PRINT" IS MOVED TO $5C00 AND THE BITMAP IS" 3610 PRINT" MOVED TO $6000 AND SAVED. THIS TRASHES" 3620 PRINT" THE ARRAY SO IF YOU WANT BOTH THEN" 3630 PRINT" SAVE THE ARRAY FIRST." 3640 PRINT" PRESS A TO SAVE ARRAY" 3650 PRINT" S TO SAVE HIRES SCREEN" 3660 PRINT" X TO EXIT" 3670 PRINT" SELECTION ";:INPUTA$ 3680 IFA$="A"THENA$="ARRAY":GOSUB3720:NAME$=NAME$+".ARY":GOTO3810 3690 IFA$="S"THENA$="SCREEN":GOSUB3720:NAME$=NAME$+".SCN":GOTO3740 3700 IFA$<>"X"THEN3670 3710 PRINTCHR$(147):GOTO3120:REM EXIT 3720 PRINT" EXTENSION '.ARY' OR '.SCN' IS ADDED TO YOUR FILENAME" 3730 PRINT" SAVE ";A$;" AS -> ";:INPUTNAME$:RETURN 3740 DATA 120,169,48,133,1,160,0,162,4,32,237,203,169,224,141,239,203,162 3750 DATA 32,32,237,203,169,55,133,1,88,96,185,0,204,153,0,92,200,208,247,238 3760 DATA 239,203,238,242,203,202,208,238,96 3770 FOR I=52177 TO 52223:READ A:POKE I,A:NEXT I 3780 SYS 52177:REM MOVE SCREEN DOWN TO $5C00 3790 SL=0:SH=92:EL=0:EH=128 3800 GOTO3850 3810 D(0,33)=LE:D(1,33)=MX:D(2,33)=MY:D(3,33)=TAX:D(4,33)=TAY 3820 D(5,33)=XS:D(6,33)=YS:D(7,33)=ZS:D(8,33)=SEALEVEL:D(9,33)=MC 3830 SL=PEEK(47):SH=PEEK(48):EL=PEEK(49):EH=PEEK(50) 3840 REM BSAVE NAME$,A%,L% 3850 SYS57812(NAME$),8:POKE193,SL:POKE194,SH:POKE174,EL:POKE175,EH:SYS62954 3860 PRINTCHR$(147) 3870 GOTO4240 3880 REM ============================= 3890 PRINT" *** ARRAY OR SCREEN LOAD ***" 3900 NAME$="" 3910 PRINT" THE SCREEN IS LOADED AT $5C00 " 3915 PRINT"THE COLOR SCREEN IS MOVED UP TO $CC00" 3930 PRINT"AND THE BITMAP IS MOVED TO $E000" 3940 PRINT" THIS TRASHES THE ARRAY SO IF YOU " 3950 PRINT"WANT TO LOAD BOTH THEN LOAD THE" 3960 PRINT"HIRES SCREEN FIRST." 3970 PRINT" PRESS A TO LOAD ARRAY" 3980 PRINT" S TO LOAD HIRES SCREEN" 3990 PRINT" X TO EXIT" 4000 PRINT" SELECTION ";:INPUTA$ 4010 IFA$="A"THENA$="ARRAY":GOSUB4050:NAME$=NAME$+".ARY":GOTO4090 4020 IFA$="S"THENA$="SCREEN":GOSUB4050:NAME$=NAME$+".SCN":GOTO4080 4030 IFA$<>"X"THEN4000 4040 PRINTCHR$(147):GOTO3120:REM EXIT 4050 PRINT"ENTER THE FILENAME WITHOUT THE EXTENSION '.ARY' OR '.SCN'" 4060 PRINT" NAME OF ";A$;" TO LOAD -> ";:INPUTNAME$:RETURN 4070 RETURN 4080 REM LOAD SCREEN 4082 SYS57812(NAME$),8:POKE195,0:POKE196,92:POKE780,0:SYS62626 4084 FOR I=0TO1023:POKE52224+I,PEEK(23552+I:NEXT 4086 FOR I=0TO8191:POKE57344+I,PEEK(24576+I:NEXT:GOTO 4240 4090 REM LOAD ARRAY 4100 SYS57812(NAME$),8:POKE195,PEEK(47):POKE196,PEEK(48):POKE780,0:SYS62626 4110 LE=D(0,33):MX=D(1,33):MY=D(2,33):AX=D(3,33):AY=D(4,33) 4120 XS=D(5,33):YS=D(6,33):ZS=D(7,33):SEALEVEL=D(8,33):MC=D(9,33) 4130 PRINTCHR$(147) 4140 PRINT"ARRAY NAME -> ";NAME$ 4150 PRINT"NUMBER OF LEVELS -> ";LE 4160 IFSEALEVEL=0THENLEVEL$="OFF":GOTO4180 4170 LEVEL$="ON" 4180 PRINT"SEA LEVEL DISPLAY -> ";LEVEL$ 4190 IFMC=0THENPRINT"BITMAP MODE -> STANDARD" 4200 IFMC=1THENPRINT"BITMAP MODE -> MULTICOLOR" 4210 PRINT"SCALING VALUES -> X=";XS 4220 PRINT" Y=";YS 4230 PRINT" Z=";ZS 4240 PRINT" PRESS ANY KEY TO CONTINUE" 4250 GOSUB1390 4260 PRINTCHR$(147) 4270 GOTO3120 4280 REM ============================= 4290 REM ** REDISPLAY BITMAP SCREEN ** 4300 IFMC=1THENSYSHIRES,1:GOTO4320 4310 SYSHIRES,0 4320 POKE53280,4:GOSUB1390:GOTO3120 4330 REM ============================= 4340 PRINT" *** SET SEA LEVEL OPTION ***" 4350 PRINT" DISPLAY SEA LEVEL SURFACE (Y/N) ";:INPUTA$ 4360 IFA$="Y"THEN GOTO4390 4370 SEALEVEL=0:IF MC=0 THEN C1=11:GOTO4410 4380 C1=5:C2=11:C3=1:GOTO4410 4390 SEALEVEL=1:IF MC=0 THEN C1=11:GOTO4410 4400 C1=6:C2=5:C3=11 4410 PRINTCHR$(147):GOTO 3120 4420 REM ============================= 4430 PRINT" *** SET BITMAP MODE ***" 4440 PRINT" (S)TANDARD BITMAP" 4450 PRINT" (M)ULTICOLOR BITMAP" 4460 PRINT" SELECT BITMAP MODE (S/M):";:INPUTA$ 4470 IF A$="M" THEN 4490 4480 MC=0:C1=11:GOTO4510 4490 MC=1:IF SEALEVEL=0 THEN C1=5:C2=11:C3=1:GOTO 4510 4500 C1=6:C2=5:C3=11 4510 PRINTCHR$(147):GOTO 3120 4520 REM ============================= 4530 REM *** ERROR TRAP *** 4540 REM ONERRORGOTO4540 4550 A=0 4560 GOTO3120 4570 REM ============================= 4580 PRINT" *** REDRAW OLD ARRAY ***" 4590 IFLE=0THEN3120 4600 RH=PI*30/180:VT=RH*1.2 4610 PRINT" CLEAR SCREEN BEFORE RE-DRAW (Y/N):";:INPUTA$ 4620 PRINTCHR$(147) 4630 IFA$="Y"THEN GOTO 3030 4640 POKE53280,4:IFMC=1THENSYSHIRES,1:GOTO4660 4650 SYSHIRES,0 4660 GOTO 3060 4670 REM ============================= 4680 REM *** SCALING SETTINGS *** 4690 SYSTEXT:PRINTCHR$(147) 4700 PRINT" CURRENT SCALING SETTINGS :" 4710 PRINT:PRINT" X=";XS 4720 PRINT" Y=";YS 4730 PRINT" Z=";ZS 4740 PRINT" PRESS C TO CHANGE SETTINGS" 4750 PRINT" D FOR DEFAULT SETTINGS" 4760 PRINT" X TO EXIT" 4770 REM GOSUB4500 4780 PRINT" SELECTION ";:INPUTA$ 4790 IFA$="C"THEN4840 4800 IFA$="D"THENGOSUB4870:GOTO4830 4810 IFA$<>"X"THEN4830 4820 PRINTCHR$(147):GOTO3120 4830 PRINTCHR$(147):GOTO4700 4840 PRINT" INPUT NEW X,Y,Z ";:INPUTXS,YS,ZS 4850 GOTO4830 4860 REM ============================= 4870 REM *** STOCK SCALING FACTORS *** 4880 XS=.04:YS=.04:ZS=.05:RETURN 4890 REM ============================= 4900 REM **** ERROR TRAP **** 4910 FMEM%=FRE(1) 4920 REM "RATS - AN ERROR OCCURRED" 4930 SYSTEXT:PRINTCHR$(147) 4950 PRINT"THERE ARE ";FMEM%;" BYTES OF MEMORY " 4955 PRINT" PRESS 'E' TO EXIT TO BASIC" 4960 PRINT" PRESS ANY KEY TO CONTINUE...." 4970 GOSUB1390 4980 PRINTCHR$(147) 4985 IF A$="E" THEN END 4990 GOTO3120